home *** CD-ROM | disk | FTP | other *** search
/ TOS Silver 2000 / TOS Silver 2000.iso / programm / MM2_DEV / S / MYUTIL / TOSDEB_2.I < prev    next >
Encoding:
Text File  |  1992-02-13  |  12.7 KB  |  574 lines
  1. ⓪ IMPLEMENTATION MODULE TOSDebug;(* V#053 *)  (* Überarbeitet von M.Grebe *)
  2. ⓪ (*$B+,R-,F-*)
  3. ⓪ 
  4. ⓪ (*
  5. ⓪"Stand Nov. 1991:
  6. ⓪$- Der Debugger reserviert sich einen eigenen Bildschirm und speichert
  7. ⓪&die Cursorpositionen zwischen, sodaß der Bildschirmaufbau nicht mehr
  8. ⓪&gestört wird.
  9. ⓪$- Mit T läßt sich eine Protokollierung der Ausgabe in der Datei DEBUG.LST
  10. ⓪&im Root-Verzeichnis des aktuellen Laufwerks ein- bzw. ausschalten.
  11. ⓪$- ESC schaltet auf den Programmbildschirm und zurück
  12. ⓪$- B unterdrückt die Bildschirmausgabe, die eventuelle Protokollierung in
  13. ⓪&eine Datei läuft weiter
  14. ⓪$- P zeigt die aktuelle Prozedur
  15. ⓪$- L ab der aktuellen Zeile wird ein Listing der folgenden Zeilen
  16. ⓪&bis zum Prozedur- oder Programmende ausgegeben.
  17. ⓪$- M setzt eine Marke (B wie Breakpoint schon vergeben) hinter der der
  18. ⓪&Programmablauf wieder unterbrochen wird.
  19. ⓪&Die Zeilenadresse erhält man aus L. Somit ist dieser Breakpoint
  20. ⓪&auf die aktuelle Prozedur beschränkt, aber immerhin
  21. ⓪$- Z schaltet nun Zeilenadressen ab (ich brauchte L)
  22. ⓪ 
  23. ⓪$Bekannte Fehler:
  24. ⓪&Läuft nicht mit Programmen, die selbst den Bildschirm umlegen.
  25. ⓪&Man könnte es zwar einbauen, indem man sich immer die aktuellen
  26. ⓪&Adressen holt, ich habe es aber noch nie grbraucht - drum.
  27. ⓪ *)
  28. ⓪ 
  29. ⓪ FROM SYSTEM IMPORT ADR,ADDRESS,ASSEMBLER,BYTE,CAST,WORD,LONGWORD;
  30. ⓪ 
  31. ⓪ FROM Excepts IMPORT InstallPreExc;
  32. ⓪ 
  33. ⓪ FROM PrgCtrl IMPORT TermProcess,CatchProcessTerm,TermCarrier;
  34. ⓪ 
  35. ⓪ FROM Strings IMPORT Assign,Empty,Insert,Length;
  36. ⓪ 
  37. ⓪ FROM MOSGlobals IMPORT UserBreak,MemArea;
  38. ⓪ 
  39. ⓪ FROM SysTypes IMPORT ExcSet,TRAP5,ExcDesc;
  40. ⓪ 
  41. ⓪ FROM Terminal IMPORT GotoXY,Read,Write,WriteLn,CondRead,WriteString,
  42. ⓪5FlushKbd,ReadString;
  43. ⓪ 
  44. ⓪ FROM ModCtrl IMPORT GetModName;
  45. ⓪ 
  46. ⓪ FROM SysUtil1 IMPORT Peek;
  47. ⓪ 
  48. ⓪ FROM Files IMPORT Access,ReplaceMode,Create,Close,File;
  49. ⓪ 
  50. ⓪ FROM GEMDOS IMPORT Alloc,Free;
  51. ⓪ 
  52. ⓪ FROM XBIOS IMPORT ScreenPhysicalBase,ScreenLogicalBase,SetScreenBase,VSync;
  53. ⓪ 
  54. ⓪ IMPORT StrConv,Text;
  55. ⓪ 
  56. ⓪ CONST ypos=24;
  57. ⓪&space='    ';
  58. ⓪ 
  59. ⓪ TYPE Mode=(m2Line,asmLine,procEntry,procExit);
  60. ⓪ 
  61. ⓪ VAR waitnext,waitkey,screen,file,debugscreen,switchscreen,breakpoint:BOOLEAN;
  62. ⓪$outfile:File;
  63. ⓪$allocadr,logbase,physbase,debugbase:ADDRESS;
  64. ⓪$level:LONGINT;
  65. ⓪$breakadr:LONGCARD;
  66. ⓪$xpos:CARDINAL;
  67. ⓪ 
  68. ⓪ PROCEDURE SaveCur;
  69. ⓪ BEGIN
  70. ⓪"Write(33C); Write('j');
  71. ⓪ END SaveCur;
  72. ⓪ 
  73. ⓪ PROCEDURE RestoreCur;
  74. ⓪ BEGIN
  75. ⓪"Write(33C); Write('k');
  76. ⓪ END RestoreCur;
  77. ⓪ 
  78. ⓪ PROCEDURE WriteNew(ch:CHAR);
  79. ⓪ BEGIN
  80. ⓪"IF screen THEN
  81. ⓪$Write(ch);
  82. ⓪$INC(xpos)
  83. ⓪"END;
  84. ⓪"IF file THEN
  85. ⓪$Text.Write(outfile,ch)
  86. ⓪"END;
  87. ⓪ END WriteNew;
  88. ⓪ 
  89. ⓪ PROCEDURE ConvTab(VAR str:ARRAY OF CHAR);
  90. ⓪ VAR pos:CARDINAL;
  91. ⓪$ok:BOOLEAN;
  92. ⓪ BEGIN
  93. ⓪"pos:=LENGTH(str);
  94. ⓪"IF pos>0 THEN
  95. ⓪$REPEAT
  96. ⓪&DEC(pos);
  97. ⓪&IF str[pos]=CHR(9) THEN
  98. ⓪(str[pos]:=' ';
  99. ⓪(Insert(' ',pos,str,ok);
  100. ⓪&END
  101. ⓪$UNTIL pos=0
  102. ⓪"END
  103. ⓪ END ConvTab;
  104. ⓪ 
  105. ⓪ PROCEDURE WriteStringNew(s:ARRAY OF CHAR);
  106. ⓪ VAR i:CARDINAL;
  107. ⓪$ok:BOOLEAN;
  108. ⓪$str:ARRAY[0..128] OF CHAR;
  109. ⓪ BEGIN
  110. ⓪"Assign(s,str,ok);
  111. ⓪"ConvTab(str);
  112. ⓪"IF screen THEN
  113. ⓪$INC(xpos,Length(str));
  114. ⓪$WriteString(str)
  115. ⓪"END;
  116. ⓪"IF file THEN
  117. ⓪$Text.WriteString(outfile,str)
  118. ⓪"END;
  119. ⓪ END WriteStringNew;
  120. ⓪ 
  121. ⓪ PROCEDURE WriteLnNew;
  122. ⓪ BEGIN
  123. ⓪"IF screen THEN
  124. ⓪$WriteLn; xpos:=0
  125. ⓪"END;
  126. ⓪"IF file THEN
  127. ⓪$Text.WriteLn(outfile)
  128. ⓪"END;
  129. ⓪ END WriteLnNew;
  130. ⓪ 
  131. ⓪ PROCEDURE WriteLHex(v:LONGWORD);
  132. ⓪ BEGIN
  133. ⓪"WriteStringNew(StrConv.LHexToStr(v,9))
  134. ⓪ END WriteLHex;
  135. ⓪ 
  136. ⓪ PROCEDURE ShowProc(adr:LONGCARD);
  137. ⓪ VAR proc,name:ARRAY [0..39] OF CHAR; rel:LONGCARD;
  138. ⓪ BEGIN
  139. ⓪"GetModName(adr,name,rel,proc);
  140. ⓪"WriteLnNew;
  141. ⓪"WriteStringNew('Modul '); WriteStringNew(name); WriteNew(',');
  142. ⓪"WriteStringNew('Procedure '); WriteStringNew(proc); WriteLnNew;
  143. ⓪ END ShowProc;
  144. ⓪ 
  145. ⓪ PROCEDURE Listing(listadr:LONGCARD);
  146. ⓪ TYPE String=ARRAY[0..255] OF CHAR;
  147. ⓪ VAR dummy:LONGCARD;
  148. ⓪$ptr:POINTER TO CARDINAL;
  149. ⓪$strptr:POINTER TO String;
  150. ⓪$ch:CHAR;
  151. ⓪ BEGIN
  152. ⓪"ShowProc(listadr);
  153. ⓪"ptr:=CAST(ADDRESS,listadr-2L);
  154. ⓪"REPEAT
  155. ⓪$INC(ptr,2L);
  156. ⓪$IF ptr^=$4e45 THEN
  157. ⓪&INC(ptr,2L);
  158. ⓪&IF (ptr^=0) OR (ptr^=10) THEN
  159. ⓪(strptr:=CAST(ADDRESS,ptr);
  160. ⓪(INC(strptr,2L);
  161. ⓪(ptr:=ptr+CAST(ADDRESS,Length(strptr^)-2);
  162. ⓪(IF ODD(ptr) THEN
  163. ⓪*INC(ptr)
  164. ⓪(END;
  165. ⓪(WriteLHex(CAST(LONGCARD,ptr)+4L); WriteStringNew(strptr^); WriteLnNew;
  166. ⓪&END
  167. ⓪$END;
  168. ⓪"UNTIL ptr^=$4e5d;
  169. ⓪ END Listing;
  170. ⓪ 
  171. ⓪ PROCEDURE dispRegs(VAR info:ExcDesc);
  172. ⓪ BEGIN
  173. ⓪"WriteLnNew;
  174. ⓪"WITH info DO
  175. ⓪$WriteStringNew('D0:');  WriteLHex(regD0);
  176. ⓪$WriteStringNew(' D1:'); WriteLHex(regD1);
  177. ⓪$WriteStringNew(' D2:'); WriteLHex(regD2);
  178. ⓪$WriteStringNew(' D3:'); WriteLHex(regD3);
  179. ⓪$WriteLnNew;
  180. ⓪$WriteStringNew('D4:');  WriteLHex(regD4);
  181. ⓪$WriteStringNew(' D5:'); WriteLHex(regD5);
  182. ⓪$WriteStringNew(' D6:'); WriteLHex(regD6);
  183. ⓪$WriteStringNew(' D7:'); WriteLHex(regD7);
  184. ⓪$WriteLnNew;
  185. ⓪$WriteStringNew('A0:');  WriteLHex(regA0);
  186. ⓪$WriteStringNew(' A1:'); WriteLHex(regA1);
  187. ⓪$WriteStringNew(' A2:'); WriteLHex(regA2);
  188. ⓪$WriteStringNew(' A3:'); WriteLHex(regA3);
  189. ⓪$WriteLnNew;
  190. ⓪$WriteStringNew('A4:');  WriteLHex(regA4);
  191. ⓪$WriteStringNew(' A5:'); WriteLHex(regA5);
  192. ⓪$WriteStringNew(' A6:'); WriteLHex(regA6);
  193. ⓪$WriteStringNew(' A7:'); WriteLHex(regUSP);
  194. ⓪"END
  195. ⓪ END dispRegs;
  196. ⓪ 
  197. ⓪ PROCEDURE dispLine(mode:Mode; VAR info:ExcDesc);
  198. ⓪ VAR buffered:BOOLEAN; bufCh:CHAR;
  199. ⓪ 
  200. ⓪"PROCEDURE KeyPress():BOOLEAN;
  201. ⓪"BEGIN
  202. ⓪$CondRead(bufCh,buffered);
  203. ⓪$RETURN buffered
  204. ⓪"END KeyPress;
  205. ⓪ 
  206. ⓪"PROCEDURE GetKey(VAR ch:CHAR);
  207. ⓪"BEGIN
  208. ⓪$IF buffered THEN
  209. ⓪&buffered:=FALSE;
  210. ⓪&ch:=bufCh
  211. ⓪$ELSE
  212. ⓪&Read(ch)
  213. ⓪$END
  214. ⓪"END GetKey;
  215. ⓪ 
  216. ⓪ VAR ch:CHAR;
  217. ⓪$s:ARRAY[0..9] OF CHAR;
  218. ⓪$p:CARDINAL;
  219. ⓪$done,ok:BOOLEAN;
  220. ⓪$ps:POINTER TO ARRAY[0..160] OF CHAR;
  221. ⓪$proc,name:ARRAY[0..39] OF CHAR;
  222. ⓪$rel:LONGCARD;
  223. ⓪ 
  224. ⓪ BEGIN(* dispLine *)
  225. ⓪"IF Active THEN
  226. ⓪$Step:=0L
  227. ⓪"END;
  228. ⓪"IF (Step<>0L) THEN
  229. ⓪$DEC(Step);
  230. ⓪$IF (Step=0L) OR breakpoint THEN
  231. ⓪&Active:=TRUE; Continuous:=FALSE; switchscreen:=TRUE; breakadr:=0L;
  232. ⓪&SetScreenBase(debugbase,debugbase,-1);
  233. ⓪&VSync;
  234. ⓪&GotoXY(xpos,ypos); WriteLn;
  235. ⓪$END
  236. ⓪"END;
  237. ⓪"xpos:=0;
  238. ⓪"IF waitkey THEN
  239. ⓪$buffered:=FALSE;
  240. ⓪$IF ~Continuous OR KeyPress() THEN
  241. ⓪&IF Step<>0L THEN
  242. ⓪(SetScreenBase(debugbase,debugbase,-1);
  243. ⓪(VSync;
  244. ⓪(Active:=TRUE; Continuous:=FALSE; switchscreen:=TRUE;
  245. ⓪&END;
  246. ⓪&REPEAT
  247. ⓪(GetKey(ch);
  248. ⓪(ok:=TRUE;
  249. ⓪(CASE CAP(ch) OF
  250. ⓪*11C : SetScreenBase(debugbase,-1L,-1);              (* Tab *)
  251. ⓪0VSync;
  252. ⓪0Write(33C); Write('E'); ok:=FALSE |
  253. ⓪*33C : debugscreen:=~debugscreen; ok:=FALSE;          (* ESC *)
  254. ⓪0IF debugscreen THEN
  255. ⓪2SetScreenBase(-1L,debugbase,-1)
  256. ⓪0ELSE
  257. ⓪2SetScreenBase(-1L,physbase,-1)
  258. ⓪0END;
  259. ⓪0VSync |
  260. ⓪*15C : Continuous:=TRUE|                            (* RETURN *)
  261. ⓪*' ' : Continuous:=FALSE|                           (* SPACE *)
  262. ⓪*3C  : TermProcess(UserBreak)|                      (* CTRL-C *)
  263. ⓪*'A' : Step:=0L; Active:=TRUE; Continuous:=FALSE |
  264. ⓪*'S' : WriteString('Step? '); ReadString(s); p:=0;
  265. ⓪0Step:=StrConv.StrToLCard(s,p,done);
  266. ⓪0IF done THEN
  267. ⓪2Active:=FALSE; Continuous:=TRUE;
  268. ⓪2switchscreen:=FALSE;
  269. ⓪0END|
  270. ⓪*'Z' : LineAddr:=~LineAddr; ok:=FALSE|
  271. ⓪*'H' : Hex:=TRUE; ok:=FALSE|
  272. ⓪*'D' : Hex:=FALSE; ok:=FALSE|
  273. ⓪*'R' : dispRegs(info); ok:=FALSE|
  274. ⓪*'B' : screen:=~screen; ok:=FALSE;
  275. ⓪0IF screen THEN
  276. ⓪2WriteString('Bildschirmausgabe aktiv'); switchscreen:=TRUE;
  277. ⓪0ELSE
  278. ⓪2WriteString('Bildschirmausgabe inaktiv'); switchscreen:=FALSE;
  279. ⓪0END;
  280. ⓪0WriteLn |
  281. ⓪*'M' : WriteString('Breakpoint nach Zeile an Adresse:'); ReadString(s); p:=0;
  282. ⓪0breakadr:=StrConv.StrToLCard(s,p,done);
  283. ⓪0IF done THEN
  284. ⓪2Active:=FALSE; Continuous:=TRUE; Step:=4294967295;
  285. ⓪2switchscreen:=FALSE;
  286. ⓪0ELSE
  287. ⓪2breakadr:=0L;
  288. ⓪0END;
  289. ⓪0breakpoint:=FALSE |
  290. ⓪*'T' : file:=~file; ok:=FALSE;
  291. ⓪0IF file THEN
  292. ⓪2WriteString('Dateiausgabe aktiv')
  293. ⓪0ELSE
  294. ⓪2WriteString('Dateiausgabe inaktiv')
  295. ⓪0END;
  296. ⓪0WriteLn |
  297. ⓪*'L' : Listing(info.regPC); ok:=FALSE |
  298. ⓪*'P' : ShowProc(info.regPC); ok:=FALSE |
  299. ⓪(ELSE
  300. ⓪*ok:=FALSE
  301. ⓪(END
  302. ⓪&UNTIL ok
  303. ⓪$END
  304. ⓪"END;
  305. ⓪"IF waitnext THEN
  306. ⓪$FlushKbd; waitkey:=TRUE; waitnext:=FALSE
  307. ⓪"END;
  308. ⓪"ps:=info.regPC;                   (* PC hinter Zeilentext setzen *)
  309. ⓪"INC(info.regPC,Length(ps^)+1);
  310. ⓪"IF ODD(info.regPC) THEN
  311. ⓪$INC(info.regPC)
  312. ⓪"END;
  313. ⓪"IF breakadr=info.regPC THEN
  314. ⓪$breakpoint:=TRUE
  315. ⓪"END;
  316. ⓪"IF Active THEN                     (* Zeile anzeigen *)
  317. ⓪$WriteLnNew;
  318. ⓪$IF (mode=m2Line) OR (mode=asmLine) THEN
  319. ⓪&WriteLnNew;
  320. ⓪&IF LineAddr THEN
  321. ⓪(WriteLHex(info.regPC);
  322. ⓪(WriteStringNew(':');
  323. ⓪(GetModName(info.regPC,name,rel,proc);
  324. ⓪(WriteStringNew(name);
  325. ⓪(WriteStringNew(' / ');
  326. ⓪(IF ~Empty(proc) THEN
  327. ⓪*WriteStringNew(proc)
  328. ⓪(ELSE
  329. ⓪*WriteStringNew(StrConv.LHexToStr(rel,5))
  330. ⓪(END;
  331. ⓪(WriteLnNew;
  332. ⓪&END;
  333. ⓪&IF ps^[0]=12C (* LF *) THEN
  334. ⓪(INC(ps)
  335. ⓪&END;
  336. ⓪&WriteStringNew(ps^);
  337. ⓪&WriteLnNew;
  338. ⓪$ELSE
  339. ⓪&IF mode=procEntry THEN
  340. ⓪(WriteStringNew('Enter '); INC(level);
  341. ⓪&ELSE
  342. ⓪(WriteStringNew('                                   Exit '); DEC(level);
  343. ⓪&END;
  344. ⓪&WriteStringNew(ps^);
  345. ⓪&WriteStringNew(' ('); WriteStringNew(StrConv.IntToStr(level,0)); WriteNew(')');
  346. ⓪$END;
  347. ⓪"END;
  348. ⓪"SetScreenBase(logbase,physbase,-1);
  349. ⓪"VSync;
  350. ⓪ END dispLine;
  351. ⓪ 
  352. ⓪ 
  353. ⓪ PROCEDURE HdlExc(VAR info:ExcDesc):BOOLEAN;
  354. ⓪ 
  355. ⓪"PROCEDURE loadValue(VAR v:ARRAY OF BYTE);
  356. ⓪"(* holt Wert vom A3-Stack und korrigiert A3 dabei auch *)
  357. ⓪"VAR n:CARDINAL;
  358. ⓪"BEGIN
  359. ⓪$n:=HIGH(v);
  360. ⓪$IF n=0 THEN
  361. ⓪&INC(n)
  362. ⓪$END;
  363. ⓪$DEC(info.regA3.p,n+1);
  364. ⓪$Peek(info.regA3.p,v);
  365. ⓪"END loadValue;
  366. ⓪ 
  367. ⓪"PROCEDURE dispNum(size:CARDINAL; signed:BOOLEAN);
  368. ⓪"VAR by:BYTE;
  369. ⓪&wd:WORD;
  370. ⓪&lw:LONGWORD;
  371. ⓪"BEGIN
  372. ⓪$IF size=4 THEN
  373. ⓪&loadValue(lw);
  374. ⓪$ELSE
  375. ⓪&IF size=2 THEN
  376. ⓪(loadValue(wd);
  377. ⓪&ELSE
  378. ⓪(loadValue(by);
  379. ⓪(IF signed THEN
  380. ⓪*wd:=WORD(INT(by))
  381. ⓪(ELSE
  382. ⓪*wd:=WORD(ORD(by))
  383. ⓪(END
  384. ⓪&END;
  385. ⓪&IF signed THEN
  386. ⓪(lw:=LONGWORD(LONG(INTEGER(wd)))
  387. ⓪&ELSE
  388. ⓪(lw:=LONGWORD(LONG(CARDINAL(wd)))
  389. ⓪&END
  390. ⓪$END;
  391. ⓪$IF Active THEN
  392. ⓪&IF Hex THEN
  393. ⓪(WriteStringNew(StrConv.LHexToStr(lw,0))
  394. ⓪&ELSIF signed THEN
  395. ⓪(WriteStringNew(StrConv.IntToStr(LONGINT(lw),0));
  396. ⓪&ELSE
  397. ⓪(WriteStringNew(StrConv.CardToStr(LONGCARD(lw),0));
  398. ⓪&END
  399. ⓪$END;
  400. ⓪"END dispNum;
  401. ⓪ 
  402. ⓪"PROCEDURE dispChar();
  403. ⓪"VAR ch:CHAR;
  404. ⓪"BEGIN
  405. ⓪$loadValue(ch);
  406. ⓪$IF Active THEN
  407. ⓪&IF ch<' ' THEN       (* Steuerzeichen als Oktalkonstante anzeigen *)
  408. ⓪(WriteStringNew(StrConv.NumToStr(ORD(ch),8,0,' '));
  409. ⓪(WriteNew('C')
  410. ⓪&ELSE
  411. ⓪(WriteNew("'");
  412. ⓪(WriteNew(ch);
  413. ⓪(WriteNew("'");
  414. ⓪&END
  415. ⓪$END;
  416. ⓪"END dispChar;
  417. ⓪ 
  418. ⓪"PROCEDURE dispReal(long:BOOLEAN);
  419. ⓪"VAR sr:REAL;
  420. ⓪&lr:LONGREAL;
  421. ⓪"BEGIN
  422. ⓪$IF long THEN
  423. ⓪&loadValue(lr)
  424. ⓪$ELSE
  425. ⓪&loadValue(sr);
  426. ⓪&lr:=LONG(sr)
  427. ⓪$END;
  428. ⓪$IF Active THEN
  429. ⓪&WriteStringNew(StrConv.RealToStr(lr,0,6))
  430. ⓪$END;
  431. ⓪"END dispReal;
  432. ⓪ 
  433. ⓪"PROCEDURE dispBool();
  434. ⓪"VAR b:BOOLEAN;
  435. ⓪"BEGIN
  436. ⓪$loadValue(b);
  437. ⓪$IF Active THEN
  438. ⓪&IF b THEN
  439. ⓪(WriteStringNew('TRUE ')
  440. ⓪&ELSE
  441. ⓪(WriteStringNew('FALSE')
  442. ⓪&END
  443. ⓪$END;
  444. ⓪"END dispBool;
  445. ⓪ 
  446. ⓪"PROCEDURE dispString();
  447. ⓪"(* Für Strings werden Adresse und HIGH-Wert auf dem A3-Stack abgelegt *)
  448. ⓪"VAR high:CARDINAL;
  449. ⓪&ptr:POINTER TO CHAR;
  450. ⓪"BEGIN
  451. ⓪$loadValue(high);
  452. ⓪$loadValue(ptr);
  453. ⓪$IF Active THEN
  454. ⓪&WriteNew('"');
  455. ⓪&LOOP
  456. ⓪(IF ptr^=0C THEN
  457. ⓪*EXIT
  458. ⓪(END;
  459. ⓪(WriteNew(ptr^);
  460. ⓪(INC(ptr);
  461. ⓪(IF high=0 THEN
  462. ⓪*EXIT
  463. ⓪(END;
  464. ⓪(DEC(high)
  465. ⓪&END;
  466. ⓪&WriteNew('"')
  467. ⓪$END;
  468. ⓪"END dispString;
  469. ⓪ 
  470. ⓪ VAR no:CARDINAL;
  471. ⓪$old:BOOLEAN;
  472. ⓪ 
  473. ⓪ BEGIN
  474. ⓪"SaveCur;
  475. ⓪"IF switchscreen THEN
  476. ⓪$SetScreenBase(debugbase,debugbase,-1);
  477. ⓪$VSync
  478. ⓪"END;
  479. ⓪"GotoXY(xpos,ypos);
  480. ⓪"no:=CARDINAL(info.regPC^);
  481. ⓪"INC(info.regPC,2);
  482. ⓪"CASE no OF
  483. ⓪%0 : dispLine(m2Line,info)|
  484. ⓪$64 : dispLine(asmLine,info)|
  485. ⓪$66 : dispLine(procEntry,info)|
  486. ⓪$67 : dispLine(procExit,info)|
  487. ⓪"ELSE
  488. ⓪$CASE no OF
  489. ⓪*1,4 : dispNum(4,TRUE)|
  490. ⓪,2 : dispReal(TRUE)|
  491. ⓪+40 : dispReal(FALSE)|
  492. ⓪,3 : dispChar()|
  493. ⓪&35,34,9 : dispNum(2,FALSE)|
  494. ⓪ 8,20,23,25,26 : old:=Hex; Hex:=TRUE; dispNum(4,FALSE); Hex:=old|
  495. ⓪(21,41 : old:=Hex; Hex:=TRUE; dispNum(2,FALSE); Hex:=old|
  496. ⓪(30,22 : dispNum(4,FALSE)|
  497. ⓪+24 : dispBool()|
  498. ⓪+27 : dispString()|
  499. ⓪+33 : dispNum(2,TRUE)|
  500. ⓪(38,39 : old:=Hex; Hex:=TRUE; dispNum(1,FALSE); Hex:=old|
  501. ⓪$ELSE
  502. ⓪(DEC(info.regPC,2);
  503. ⓪(SetScreenBase(logbase,physbase,-1);
  504. ⓪(VSync;
  505. ⓪(RETURN TRUE
  506. ⓪$END;
  507. ⓪$IF Active THEN
  508. ⓪&WriteStringNew('   ')
  509. ⓪$END
  510. ⓪"END;
  511. ⓪"SetScreenBase(logbase,physbase,-1);
  512. ⓪"VSync;
  513. ⓪"RestoreCur;
  514. ⓪"RETURN FALSE
  515. ⓪ END HdlExc;
  516. ⓪ 
  517. ⓪ VAR stk:ARRAY[1..2000] OF WORD;
  518. ⓪$wsp:MemArea;
  519. ⓪$hdl:ADDRESS;
  520. ⓪$tHdl:TermCarrier;
  521. ⓪ 
  522. ⓪ PROCEDURE Terminate;
  523. ⓪ VAR ch:CHAR;
  524. ⓪ BEGIN
  525. ⓪"WriteLnNew;
  526. ⓪"screen:=TRUE;
  527. ⓪"WriteStringNew('Programmende:Bitte Taste...');
  528. ⓪"Close(outfile);
  529. ⓪"Read(ch);
  530. ⓪"SetScreenBase(logbase,physbase,-1);
  531. ⓪"VSync;
  532. ⓪"IF allocadr<>0L THEN
  533. ⓪$IF Free(allocadr) THEN END
  534. ⓪"END
  535. ⓪ END Terminate;
  536. ⓪ 
  537. ⓪ BEGIN
  538. ⓪"breakadr:=0L;
  539. ⓪"Active:=TRUE;
  540. ⓪"Step:=0L;
  541. ⓪"Continuous:=FALSE;
  542. ⓪"Hex:=FALSE;
  543. ⓪"LineAddr:=FALSE;
  544. ⓪"screen:=TRUE; file:=FALSE;
  545. ⓪"level:=-1L;
  546. ⓪"Create(outfile,'\DEBUG.LST',writeOnly,replaceOld);
  547. ⓪"logbase:=ScreenLogicalBase();
  548. ⓪"physbase:=ScreenPhysicalBase();
  549. ⓪"Alloc(33000L,allocadr);
  550. ⓪"IF allocadr=0L THEN
  551. ⓪$debugbase:=logbase
  552. ⓪"ELSE
  553. ⓪$debugbase:=(allocadr DIV 256L)*256L+256L;
  554. ⓪$SetScreenBase(debugbase,-1L,-1);
  555. ⓪$VSync;
  556. ⓪$Write(33C); Write('E');
  557. ⓪$SetScreenBase(logbase,-1L,-1);
  558. ⓪$VSync;
  559. ⓪"END;
  560. ⓪"debugscreen:=TRUE;
  561. ⓪"switchscreen:=TRUE;
  562. ⓪"(* damit erste Zeile sofort erscheint: *)
  563. ⓪"waitkey:=FALSE;
  564. ⓪"waitnext:=TRUE;
  565. ⓪"wsp.bottom:=ADR(stk);
  566. ⓪"wsp.length:=SIZE(stk);
  567. ⓪"InstallPreExc(ExcSet{TRAP5},HdlExc,TRUE,wsp,hdl);
  568. ⓪"IF hdl=NIL THEN
  569. ⓪$HALT
  570. ⓪"END;
  571. ⓪"CatchProcessTerm(tHdl,Terminate,wsp);
  572. ⓪ END TOSDebug.
  573. ⓪ 
  574. ⓪